(*
file : main.ml
Arnaud Aujon   AUJA31018906
*)



open Printf
open Lexer
open List

open Type
open Variable
open Inference
open Object
open Move
open Opt1
open Opt2

let dest_file : out_channel ref = ref stdout ;;

let write = function str -> output_string !dest_file str ;;


(* function at_exit to close files ( and remove ?) *)

(* generate_str transform list of Type.expr in a string representing his type.
Following this representation :
int    | "%d"
float  | "%f"
bool   | "%b"
string | "%s"
object | "%o"
*)

let print_bool = function
      true -> "true"
  | _ -> "false"
;;

(* generate a string that represent variable types *)
let rec generate_str args =
  match args with
    [] -> ""
  | head::tail -> 
    let str = 
    begin match head with
      T3_Int(_) -> "%d "
    | T3_Float(v) -> "%f "
    | T3_Bool(v) -> "%b "
    | T3_String(v) -> "%s "
    | T3_Array(v) -> "%a"
    | T3_Var(name) ->  begin match get_var_type name with
              TInt -> "%d "
            | TFloat -> "%f "
            | TBool -> "%b "
            | TString -> "%s "
            | TObjVar(t) -> "%o "
            | TArray -> "%a"
            | _ -> error "todo generate_str"
            end
    | T3_Function(name,_) -> begin match get_var_type name with
              TInt -> "%d "
            | TFloat -> "%f "
            | TBool -> "%b "
            | TString -> "%s "
            | TObjVar(t) -> "%o "
            | TArray -> "%a"
            | _ -> error "todo generate_str"
            end
    | _ -> error "todo generate lst"
    end in
    str^(generate_str tail)
;;

(* compile print function *)
let rec compile_print args =
  match args with
    [] -> error "missing arguments on print function"
  | [arg] -> compile_expr arg
  | head::tail -> compile_expr head ; write ", " ; compile_print tail

and compile_list args =
  match args with
    [] -> ()
  | [arg] -> compile_expr arg
  | head::tail -> compile_expr head ; write "," ; compile_list tail

and compile_expr expr = 
  match expr with
  | T3_Int(v) -> write (string_of_int v)
  | T3_Float(v) -> write (string_of_float v)
  | T3_Bool(v) -> write (print_bool v)
  | T3_String(v) -> write ("\""^v^"\"")
  | T3_Array(ls) -> write "{"; compile_list ls ; write "}";
  | T3_Pointer(name) -> write ("&"^name)
  | T3_Unary(op,e) -> write op ; compile_expr e
  | T3_Binary(e1, op, e2) -> compile_expr e1;write (" "^op^" ");compile_expr e2
  | T3_Var(name) -> write name
  | T3_Array_index(name, idx) -> write (name^"[") ; compile idx ; write ("]")
  | T3_Function(name, args) -> write (name^"(") ; compile_list args ; write ")"
  | _ -> error "todo compile_expr"

(* compile assignment *)
and compile_assignment t var value =
  let name = get_name_t3 var in  
  write (name^" = ");
  compile_expr value ;
  write ";\n" ;


and compile_decl_var name = 
  let t = get_var_type name in
  begin match t with
    TInt -> write ("int "^name)
  | TFloat -> write ("float "^name)
  | TBool -> write ("bool "^name)
  | TString -> write ("char* "^name)
  | TArray -> write ("Array "^name)
  | TObjVar(_) -> write ("ObjVar "^name^";\n"^"create_objVar(&"^name^")")
  | TNil -> write ("ObjVar "^name)
  | _ -> error ("compile_decl_var error, weird type for :"^name)
  end


(* compile if *)
and compile_if if_list =
  let compile_if_int if_list =
  match if_list with
    T3_If(cond, expr_list) ->write "else if (";compile_expr cond;write ") {\n";
                List.iter compile expr_list ; write "}\n"
  | T3_Else(expr_list) -> 
    write "else {\n" ; List.iter compile expr_list ; write "}\n"
  in

  match if_list with
    [] -> ()
  | head::tail ->
    begin match head with
      T3_If(cond, expr_list) -> write "if (";compile_expr cond;write ") {\n";
                List.iter compile expr_list ; write "}\n"
    | _ -> error "expected a if statement before else"
    end ;
    List.iter compile_if_int tail

(* compile for *)
and compile_for var e_beg e_end expr_list =
  write "for("; compile_expr var; write " = " ; compile_expr e_beg ;
  write " ; "; compile_expr var; write " <= ";
  compile_expr e_end ; write " ; "; compile_expr var; write "++) {\n" ;
  List.iter (function x -> write"\t" ; compile x) expr_list ;
  write "}\n"

and print_type t =
  match t with
    TInt -> write "int "
  | TFloat -> write "float "
  | TBool -> write "bool "
  | TString -> write "char* "
  | TArray -> write "Array "
  | TArray_int -> write "ObjVar* "
  | TObjVar(_) -> write "ObjVar "
  | TNil -> print_string "get TNil in print_type"; write "ObjVar "
  | _ -> error "compile_decl_var error"

and compile_args args =
  match args with
    [] -> ()
  | [(name, t)] -> print_type t; write name
  | (name,t)::tail -> print_type t; write (name^", "); compile_args tail

(* function declaration *)
and compile_decl_fun name args body =
  print_type (get_var_type name);
  write (name^" (") ; compile_args args ; write ") {\n";
  let old_env = !env in
    iter (function (n,t) -> (add_var t n)) args;
    iter (function T3_Typed_Decl_Var(n, t) -> add_var t n
             | _ -> () ) body;
    iter compile body ; write "}\n\n";
  env := old_env
  

(* main compile function *)
and compile expr =
  match expr with
    T3_Typed_Decl_Function(name, args, body) -> compile_decl_fun name args body
  | T3_Typed_Assignment(TArray_int, T3_Var(name), T3_Array(ls)) ->
    write ("ObjVar "^name^"["); write (string_of_int (List.length ls));
    write "] = {"; compile_list ls; write "};\n"
  | T3_Typed_Assignment(t, var, value) -> compile_assignment t var value
  | T3_Decl_Var(name) -> compile_decl_var name ; write ";\n"
  | T3_Typed_Decl_Var(name, t) -> print_type t; write (name^";\n")
  | T3_Struct_If(if_list) -> compile_if if_list
  | T3_Function(name, args) -> write (name^"(") ; compile_list args ; write ");\n"
  | T3_Print(args) -> write ("print_int(\""^generate_str args^"\", ") ;
            compile_print args ; write ");\n"
  | T3_For(var, e_beg, e_end, expr_list) -> compile_for var e_beg e_end expr_list
  | T3_While(cond, body) -> write "while ("; compile_expr cond; write ") {\n"; iter compile body; write "}\n\n"
  | T3_Return(e) -> write "return (" ; compile_expr e ; write ");\n"
  | T3_Nil -> ()
  | _ -> error ("Unexpected statement")
;;

(* main function *)
let main() =
  (* Usage *)
  let argc = Array.length Sys.argv in

  if argc == 1 then begin
    printf "%s: No input file\n" Sys.argv.(0);
    printf "%s: Usage: %s source.rb [dest.c]\n" Sys.argv.(0) Sys.argv.(0);
        exit 1
  end else
  (* define out_file name *)
  let out_file = if (argc == 2) then "out.c" else Sys.argv.(2) in
  
  if argc > 3 then begin
    printf "%s: Too many arguments\n" Sys.argv.(0);
    printf "%s: Usage: %s source.rb [dest.c]\n" Sys.argv.(0) Sys.argv.(0);
  end else
    (* open source file *)
    let input = open_in Sys.argv.(1) in
    (* open a lexer buffer *)
    let lexbuf = Lexing.from_channel input in
      let rec parse_file () =
        try
          let expr = Grammar.expr Lexer.token lexbuf in
            expr::(parse_file () )
        with 
            Parsing.Parse_error -> (error "Parse error")
          | Lexer.Eof -> []
      in
      let ast = parse_file () in
    (* create dest file *)
    dest_file := open_out out_file ;

    (* write headers *)
    write "#include <stdio.h>\n" ;
    write "#include <stdlib.h>\n" ;
    write "#include <stdbool.h>\n" ;
    write "#include <string.h>\n" ;
    write "#include <stdarg.h>\n";
    write "#include <math.h>\n\n";

    (* write objVar and Array structure *)
    write "typedef enum type {TInt, TFloat, TString, ";
    write "TArray, TBool, TNil} Type; \n\n";
    write "typedef struct {\n\tType type;\n\tvoid* value;\n} ObjVar;\n\n";
    write "typedef struct {\n\tint size;\n\tObjVar* value;\n} Array;\n\n";
    
    write "void create_objVar(ObjVar* o) {\n";
    write "\to->value = (void*)malloc(4);\n}\n\n";
    
    (* write get_var_<type> function*)
    write "int get_var_int(ObjVar o) {\n" ;
    write "\tif (o.type == TInt )\n" ;
    write "\t\treturn *(int*)(o.value);\n\telse {\n\t\t" ;
    write "printf(\"Type Error1\");\n\t\texit(0);\n\t}\n}\n\n" ;
    
    write "float get_var_float(ObjVar o) {\n" ;
    write "\tif (o.type == TFloat )\n" ;
    write "\t\treturn *(float*)(o.value) ;\n\telse {\n\t\t" ;
    write "printf(\"Type Error2\");\n\t\texit(0);\n\t}\n}\n\n" ;

    write "bool get_var_bool(ObjVar o) {\n" ;
    write "\tif (o.type == TBool )\n" ;
    write "\t\treturn *(bool*)(o.value) ;\n\telse {\n\t\t" ;
    write "printf(\"Type Error3\");\n\t\texit(0);\n\t}\n}\n\n" ;

    write "char* get_var_string(ObjVar o) {\n" ;
    write "\tif (o.type == TString )\n" ;
    write "\t\treturn (char*)(o.value) ;\n\telse {\n\t\t" ;
    write "printf(\"Type Error4\");\n\t\texit(0);\n\t}\n}\n\n" ;

    write "Array get_var_array(ObjVar o) {\n" ;
    write "\tif (o.type == TArray )\n" ;
    write "\t\treturn *(Array*)(o.value) ;\n\telse {\n\t\t" ;
    write "printf(\"Type Error5\");\n\t\texit(0);\n\t}\n}\n\n" ;
  
    write "ObjVar get_var_all(ObjVar o) {\n" ;
    write "\treturn o;\n}\n\n" ;

    (* write set_var_<type> function*)
    write "void set_var_int(ObjVar* o, int v) {\n" ;
    write "\to->type = TInt;\n" ;
    write "\t*(int*)(o->value) = v;\n}\n\n";

    write "void set_var_float(ObjVar* o, float v) {\n" ;
    write "\to->type = TFloat;\n" ;
    write "\t*(float*)(o->value) = v;\n}\n\n";

    write "void set_var_bool(ObjVar* o, bool v) {\n" ;
    write "\to->type = TBool;\n" ;
    write "\t*(float*)(o->value) = v;\n}\n\n";

    write "void set_var_string(ObjVar* o, const char* v) {\n" ;
    write "\to->type = TString;\n" ;
    write "\to->value = strcpy((char*)(o->value),v);\n}\n\n";

    write "void set_var_array(ObjVar* o, Array v) {\n" ;
    write "\to->type = TArray;\n" ;
    write "\t*(Array*)(o->value) = v;\n}\n\n";
  
    write "void set_var_all(ObjVar* o, ObjVar o2) {\n" ;
    write "\to->type = o2.type;\n";
    write "\to->value = o2.value;\n}\n\n" ;

    (* print functions *)
    write "void print_objVar(ObjVar o) {\n";
    write "\tswitch (o.type) {\n";
    write "\t\tcase TInt :\n\t\t\tprintf(\"%d\", *((int*)(o.value)));\n\t\t\tbreak;\n";
    write "\t\tcase TFloat :\n\t\t\tprintf(\"%f\", *((float*)(o.value)));\n\t\t\tbreak;\n";
    write "\t\tcase TBool :\n\t\t\tprintf(\"%s\", *((bool*)(o.value)) ? \"true\" : \"false\");\n\t\t\tbreak;\n";
    write "\t\tcase TString :\n\t\t\tprintf(\"%s\", (char*)(o.value));\n\t\t\tbreak;\n";
    write "\t\tcase TArray :\n\t\t\tprintf(\"%s\", \"todo\");\n\t\t\tbreak;\n";
    write "\t\tcase TNil :\n\t\t\tprintf(\"%s\", \"Error : object hasn't been initialized\");\n\t\t\tbreak;\n";
    write "\t}\n}\n";
    
    write "void print_array(Array a) {\n";
    write "int i;\n";
    write "for ( i = 0 ; i < a.size ; i++ ) {\n";
    write "\tprint_objVar(a.value[i]);\n}\n}\n\n";
    
    
    (* print_int function *)
    write "void print_int(const char *str, ...) {\n";
    write "\tva_list ap;\n\tint i, str_len = strlen(str);\n";
    write "\tva_start(ap, str);\n\n";
    write "\tfor(i = 0; i < str_len; i++){\n" ;
    write "\t\tif(str[i] == '%'){\n" ;
    write "\t\t\ti++;\n" ;
    write "\t\t\tswitch(str[i]){\n" ;
    write "\t\t\t\tcase 'd' :\n" ;
    write "\t\t\t\t\tprintf(\"%d\", va_arg(ap, int));\n";
    write "\t\t\t\t\tbreak;\n" ;
    write "\t\t\t\tcase 'f' :\n" ;
    write "\t\t\t\t\tprintf(\"%f\", va_arg(ap, double));\n";
    write "\t\t\t\t\tbreak;\n" ;
    write "\t\t\t\tcase 's' :\n" ;
    write "\t\t\t\t\tprintf(\"%s\", va_arg(ap, char*));\n";
    write "\t\t\t\t\tbreak;\n" ;
    write "\t\t\t\tcase 'b' :\n" ;
    write "\t\t\t\t\tprintf(\"%s\", (va_arg(ap, int) == 0) ? \"false\" : \"true\");\n";
    write "\t\t\t\t\tbreak;\n" ;
    write "\t\t\t\tcase 'o' :\n" ;
    write "\t\t\t\t\tprint_objVar( va_arg(ap, ObjVar));\n";
    write "\t\t\t\t\tbreak;\n" ;
    write "\t\t\t\tcase 'a' :\n" ;
    write "\t\t\t\t\tprint_array( va_arg(ap, Array));\n";
    write "\t\t\t\t\tbreak;\n" ;
    write "\t\t\t\tcase '%' :\n" ;
    write "\t\t\t\t\tprintf(\"%c\", '%');\n";
    write "\t\t\t\t\tbreak;\n" ;
    write "\t\t\t}\n";
    write "\t\t} else {\n\t\t\t printf(\"%c\", str[i]);\n";
    write "\t\t}\n\t}\n\tva_end(ap);\n}\n\n" ;

    (* wrap function *)
    write "ObjVar wrap_from_int(int v) {\n";
    write "\tObjVar* new = (ObjVar* )malloc(sizeof(ObjVar));\n";
    write "\tcreate_objVar(new);\n";
    write "\tset_var_int(new, v);\n";
    write "\treturn *new;\n}\n\n";

    write "ObjVar wrap_from_float(float v) {\n";
    write "\tObjVar* new = (ObjVar* )malloc(sizeof(ObjVar));\n";
    write "\tcreate_objVar(new);\n";
    write "\tset_var_float(new, v);\n";
    write "\treturn *new;\n}\n\n";

    write "ObjVar wrap_from_bool(bool v) {\n";
    write "\tObjVar* new = (ObjVar* )malloc(sizeof(ObjVar));\n";
    write "\tcreate_objVar(new);\n";
    write "\tset_var_bool(new, v);\n";
    write "\treturn *new;\n}\n\n";

    write "ObjVar wrap_from_string(char* v) {\n";
    write "\tObjVar* new = (ObjVar* )malloc(sizeof(ObjVar));\n";
    write "\tcreate_objVar(new);\n";
    write "\tset_var_string(new, v);\n";
    write "\treturn *new;\n}\n\n";

    write "ObjVar wrap_from_array(Array v) {\n";
    write "\tObjVar* new = (ObjVar* )malloc(sizeof(ObjVar));\n";
    write "\tcreate_objVar(new);\n";
    write "\tset_var_array(new, v);\n";
    write "\treturn *new;\n}\n\n";

    (* write function to manipulate array *)
    write "void add_array(Array* a, ObjVar* v, int size) {\n";
    write "\tint idx;\n";
    write "\ta->size = size;\n";
    write "\ta->value = malloc(sizeof(ObjVar)*size);\n";
    write "\tfor (idx = 0 ; idx < size ; idx++ ) {\n";
    write "\t\tset_var_all(&(a->value[idx]), v[idx]);\n\t}\n}\n\n";
	
	(* write pow for int function *)
	write "int powi(int a, int b) {\n";
	write "int r = 1;\nif ( b < 0 ) {\n";
	write "\tprintf(\"error : get negative arg for `**` operator\");\n}\n\n";
	write "while ( b > 0 ) {\n\tb--;\n\tr *= a;\n}\nreturn r;\n}\n\n";
	
	
	(* write generic pow function *)
	write "ObjVar generic_pow(ObjVar o1, ObjVar o2) {\n";
	write "ObjVar* new = (ObjVar* )malloc(sizeof(ObjVar));\n";
    write "\tcreate_objVar(new);\n";
	
	write "\tswitch (o1.type) {\n";
	write "\t\tcase TInt:\n";
	write "\t\t\tif ( o2.type == TInt ) {\n";
	write "\t\t\t\tset_var_int(new, powi(*(int*)o1.value, *(int*)o2.value)); \n\t\t\t} ";
	write "else {\n\t\t\t\tprintf(\"type error : int argument ";
	write "expected for `**` operator\");\n\t\t\t}\t";
	write "\t\t\tbreak;\n";
	write "\t\tcase TFloat:\n";
	write "\t\t\tif (o2.type == TFloat) {\n";
	write "\t\t\t\tset_var_float(new, powf(*(float*)o1.value, *(float*)o2.value));\n";
	write "\t\t\t} else { \n\t\t\t\tprintf(\"type error : float argument ";
	write "expected for `**` operator\");\n\t\t\t}\n\t\t\tbreak;";
	write "\t\tdefault:\n";
	write "\t\t\tprintf(\"Unexpected type for `**` operator\");\n\t}\n\n";
	write "return *new;\n}\n\n";
	

    print_string "before optimizations" ; print_newline () ;

    (* optimisations *)
    (* here we can possibly define RUBY CONSTANT or environnement *)
    print_string "opt1 :\n";
    let ast0 = opt1 [("PI", Float(3.14))] ast in
    print_string "opt2 :\n";
    let ast1 = opt2 ast0 in
    print_string "\nafter optimizations :\n" ;

    let ast2 = move ( ast1) in
    (* type inference *)
    env := [("argc", TInt); ("get_var_all", TObjVar(TNil)); ("get_var_int", TObjVar(TNil))] ;
    print_string "\nbegin inference\n";
    let ast3 = inference_type (ast2) in
    print_string "\nafter inference\n" ;
    print_string "\nbegin to_object\n" ;
	obj := "generic_pow"::!obj;
    let ast4 = to_object ast3 in
    print_string "\nafter to_object\n" ;

    
    let ast5 = List.map (function T3_Typed_Decl_Function(name, args, body) -> compile_decl_fun name args body ; T3_Nil 
              | x -> x) ast4 in
    (* compile to C *)
    write "int main(int argc, char** argv) {\n" ;
    List.iter compile ast5;
    write "\nreturn (0);\n}\n";
	
	(* close dest_file *)
    exit 0
;;

(* run main function *)
let _ = Printexc.print main ()
